home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / MWCC03 / MDITOOL.ZIP / MDITOOL.PAS < prev    next >
Pascal/Delphi Source File  |  1993-08-18  |  25KB  |  742 lines
  1. {**********************************************************************}
  2. {*                                                                    *}
  3. {*          Microworks Sample Application                                        *}
  4. {*                                                                    *}
  5. {*         for Borland Pascal v7.0 and Turbo Pascal for Windows v1.5           *}
  6. {*                                                                    *}
  7. {*     Copyright 1992-93 Jeff Franks (Microworks) Sydney, Australia.  *}
  8. {*                                                                    *}
  9. {*         You are free to use, modify, reproduce and distribute the      *}
  10. {*         Sample Files (and/or any modified version) in any way you      *}
  11. {*         find useful.                                                                *}
  12. {*                                                                    *}
  13. {**********************************************************************}
  14.  
  15. {*** Introduction
  16.  
  17.     Application    := MDI Window with moveable tool bar.
  18.  
  19.     Files          := MDITool.pas, MDITool.res
  20.  
  21.     Units Required := FileDlg, MObjects, MCommDlg and MWCC.dll
  22.  
  23.     Purpose        := MDITool shows you how to,
  24.  
  25.                                     1. Set up a moveable toolbar in a MDI window.
  26.  
  27.                                         2. Use an SFX 'file open' and an MWCC 'file save as' dialog box.
  28.  
  29.                                         3. Use an MWCC 'Font' common dialog box.
  30.  
  31.                                         4. Use some of the button and static objects in the MWCC library.
  32.  
  33.     Tabs           := 2
  34.  
  35.     Screen         := 800 * 600
  36.                 
  37.     Date           := August 1993.
  38.  
  39.     This updated version of MDITool adds one of the new common Font dialog boxes (TMWCCFontDlg)
  40.     and shows off one of the new buttons, the Font button, that replaces the Find button (the eye)
  41.     in earlier versions.
  42.  
  43.     MDITool shows you how to set up a moveable tool bar in a MDI window without going
  44.     to all the code that the 'MFileApp' toolbar sample in BP 7.0 does (all 39K of it).
  45.     MDITool is a streamlined piece of code (12K) that accomplishes the same thing without
  46.     using separate objects for the toolbar and each tool.
  47.  
  48.     I didn't add anything else like an editor etc., you can do that. I wanted to keep it
  49.     simple, only showing you how to set up a moveable toolbar and use some of the standard
  50.     MWCC buttons and objects.
  51.  
  52.     You can add a status bar in the same way as the toolbar eg. by using a raised TMWCCStatic
  53.     object, a text TMWCCStatic object and shortening the height of the client area.
  54.  
  55.     TMWCCBmpButton is a Borland Style (3 bitmaps) button object. If you want a smaller toolbar
  56.     just create your own bitmaps, two or three for TMWCCBmpButton or one for TMWCCButton.
  57.  
  58. ***}
  59.  
  60. program MDITool;
  61.  
  62. {$R MDITool.res}
  63.  
  64. uses WinTypes, WinProcs, WinDos, Win31, Strings, ToolHelp, CommDlg,
  65.          MObjects, MMsgBox, MCommDlg, FileDlg,
  66.          {$IFDEF Ver15}
  67.              WObjects;
  68.          {$ELSE}
  69.              Objects, OWindows, ODialogs;
  70.          {$ENDIF}
  71.  
  72. const
  73.  
  74.     {*** Toolbar Constants ***}
  75.     ctl_Top          = 101;
  76.     ctl_Left         = 102;
  77.     ctl_Right        = 103;
  78.  
  79.     {*** Button ID's ***}
  80.     idw_But1         = 201;
  81.     idw_But2         = 202;
  82.     idw_But3         = 203;
  83.     idw_But4         = 204;
  84.     idw_But5         = 205;
  85.     idw_But6         = 206;
  86.  
  87.     {*** Static ID ***}
  88.     idw_Stat1        = 401;
  89.     idd_Stat1        = 402;
  90.     idd_Stat2        = 403;
  91.  
  92.     {*** Option Menu ID's ***}
  93.     idm_TopToolbar   = 701;
  94.     idm_LeftToolbar  = 702;
  95.     idm_RightToolbar = 703;
  96.     idm_About        = 704;
  97.  
  98.     {*** Speaks for itself ***}
  99.     AppName : PChar  = 'MDITool';
  100.  
  101. type
  102.  
  103.     PAboutDialog = ^TAboutDialog;
  104.     TAboutDialog = object(TMWCCDialog)
  105.         {***
  106.  
  107.             TMWCCBmpButton is a BWCC style bitMap button object. TMWCCStatic is a static object
  108.             that displays either raised, recessed or normal static controls. WMDrawItem is required
  109.             to draw the TMWCCBmpButton ownerdraw button object.
  110.  
  111.         ***}
  112.         OkBut        : PMWCCBmpButton;
  113.         Stat1, Stat2 : PMWCCStatic;
  114.         constructor Init (AParent: PWindowsObject; AName, ABmp: PChar);
  115.         procedure SetUpWindow; virtual;
  116.         procedure WMDrawItem (var Msg: TMessage); virtual wm_First + wm_DrawItem;
  117.     end;
  118.  
  119.     PMDIButton = ^TMDIButton;
  120.     TMDIButton = object(TMWCCBmpButton)
  121.         {***
  122.  
  123.             This object declares the buttons as non-MDI so they can be displayed as buttons.
  124.  
  125.         ***}
  126.         constructor Init (AParent: PWindowsObject; AnID, X, Y: Integer;
  127.                                             IsDefault: Boolean; iBmp: Integer; AStyle: Word);
  128.         procedure DefWndProc(Var Msg : TMessage); Virtual;
  129.     end;
  130.  
  131.     PMDIStatic = ^TMDIStatic;
  132.     TMDIStatic = object(TMWCCStatic)
  133.         {***
  134.  
  135.             This object declares the static as non-MDI so it can be displayed as a static.
  136.  
  137.         ***}
  138.         constructor Init (AParent: PWindowsObject; AnId: Integer; ATitle: PChar;
  139.                                             X, Y, W, H: Integer; ATextLen, AShade: Word; IsBold: Boolean);
  140.     end;
  141.  
  142.     PMDIChild = ^TMDIChild;
  143.     TMDIChild = object(TWindow)
  144.         {***
  145.  
  146.             This MDI Child to shows off the new TMWCCFontDlg common font dialog box.
  147.  
  148.         ***}
  149.         TheFont : HFont;
  150.         constructor Init(AParent: PWindowsObject; AName: PChar);
  151.         procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  152.         procedure WMPaint (var Msg: TMessage); virtual wm_First + wm_Paint;
  153.     end;
  154.  
  155.     PMDITool = ^TMDITool;
  156.     TMDITool = object(TMDIWindow)
  157.         BkBrush : HBrush;
  158.         But1, But2, But3, But4, But5, But6 : PMDIButton;
  159.         Stat1 : PMWCCStatic;
  160.         X, Y, W, H : Integer;
  161.         ToolbarPos : Word;
  162.         constructor Init (ATitle : PChar; AMenu : HMenu);
  163.         destructor Done; virtual;
  164.         function GetClassName : PChar; virtual;
  165.         function InitChild : PWindowsobject; virtual;
  166.         procedure GetWindowClass (var AWndClass: TWndClass); virtual;
  167.         procedure SetUpWindow; virtual;
  168.         procedure InitClientWindow; virtual;
  169.         procedure WMCtlColor (var Msg: TMessage); virtual wm_First + wm_CtlColor;
  170.         procedure WMDrawItem (var Msg: TMessage); virtual wm_First + wm_DrawItem;
  171.         procedure WMSize (var Msg: TMessage); virtual wm_First + wm_Size;
  172.         procedure TopToolbar(var Msg: TMessage); virtual;
  173.         procedure LeftToolbar(var Msg: TMessage); virtual;
  174.         procedure RightToolbar(var Msg: TMessage); virtual;
  175.         procedure IDMTopToolbar (var Msg: TMessage); virtual cm_First + idm_TopToolbar;
  176.         procedure IDMLeftToolbar (var Msg: TMessage); virtual cm_First + idm_LeftToolbar;
  177.         procedure IDMRightToolbar (var Msg: TMessage); virtual cm_First + idm_RightToolbar;
  178.         procedure IDMAbout (var Msg: TMessage); virtual cm_First + idm_About;
  179.         procedure IDWBut1 (var Msg: TMessage); virtual id_First + idw_But1;
  180.         procedure IDWBut2 (var Msg: TMessage); virtual id_First + idw_But2;
  181.         procedure IDWBut3 (var Msg: TMessage); virtual id_First + idw_But3;
  182.         procedure IDWBut4 (var Msg: TMessage); virtual id_First + idw_But4;
  183.         procedure IDWBut5 (var Msg: TMessage); virtual id_First + idw_But5;
  184.         procedure IDWBut6 (var Msg: TMessage); virtual id_First + idw_But6;
  185.     end;
  186.  
  187.     PMDIToolApplication = ^TMDIToolApplication;
  188.     TMDIToolApplication = object(TApplication)
  189.         procedure InitMainWindow; virtual;
  190.     end;
  191.  
  192. var
  193.  
  194.     ColorRef : TColorRef;
  195.     HLib     : THandle;
  196.     {*** TLogFont Structure ***}
  197.     LogFont  : TLogFont;
  198.  
  199. {********** TMDIToolApplication **********}
  200.  
  201. procedure TMDIToolApplication.InitMainWindow;
  202. begin
  203.     MainWindow := New(PMDITool, Init('MDITool', LoadMenu(HInstance, 'MDIToolMenu')));
  204. end;
  205.  
  206. {********** TMDITool **********}
  207.  
  208. constructor TMDITool.Init(ATitle : PChar; AMenu : HMenu);
  209. begin
  210.     TMDIWindow.Init(ATitle, AMenu);
  211.     {***
  212.  
  213.         This sets the error mode so that if MWCC.dll is not found a normal messagebox gets
  214.         diplayed (rather than an ugly white one). The error mode is then reset to the default.
  215.  
  216.     ***}
  217.     SetErrorMode(SEM_NoOpenFileErrorBox);
  218.     hLib := LoadLibrary ('MWCC.dll');
  219.     if hLib < 32 then
  220.     begin
  221.         MessageBox(0, 'Cannot find MWCC.DLL in your Windows System subdirectory.',
  222.                                     'Application Error', mb_Ok or mb_IconStop);
  223.         TerminateApp(0, No_UAE_Box);
  224.     end;
  225.     SetErrorMode(0);
  226.     Attr.X := GetSystemMetrics(sm_CXScreen) div 8;
  227.     Attr.Y := GetSystemMetrics(sm_CYScreen) div 8;
  228.     Attr.W := (GetSystemMetrics(sm_CXScreen) div 8)*6;
  229.     Attr.H := (GetSystemMetrics(sm_CYScreen) div 8)*5-4;
  230.     {*** The buttons are initialized with the dummy values and repositioned later in WMSize ***}
  231.     But1 := New(PMDIButton, Init(@Self, idw_But1, X, Y, False, 15, 0));
  232.     But2 := New(PMDIButton, Init(@Self, idw_But2, X, Y, False, 16, 0));
  233.     But3 := New(PMDIButton, Init(@Self, idw_But3, X, Y, False, 18, 0));
  234.     But4 := New(PMDIButton, Init(@Self, idw_But4, X, Y, False, 19, 0));
  235.     But5 := New(PMDIButton, Init(@Self, idw_But5, X, Y, False, 20, 0));
  236.     But6 := New(PMDIButton, Init(@Self, idw_But6, X, Y, False, 21, 0));
  237.     {***
  238.  
  239.         The static is initialized with zero values and repositioned later in WMSize.
  240.         This static fills the gap between the last button and the window frame.
  241.  
  242.     ***}
  243.     Stat1 := New(PMDIStatic, Init(@Self, idw_Stat1, '', 0, 0, 0, 0, 0, ctl_Raised, False));
  244.     {*** Crates a brush the same color as the client area ***}
  245.     BkBrush := CreateSolidBrush(GetSysColor(color_AppWorkSpace));
  246.     {*** Positions the toolbar along the top ***}
  247.     ToolbarPos := ctl_Top;
  248. end;
  249.  
  250. destructor TMDITool.Done;
  251. begin
  252.     DeleteObject(BkBrush);
  253.     FreeLibrary(hLib);
  254.     TMDIWindow.Done;
  255. end;
  256.  
  257. function TMDITool.GetClassName;
  258. begin
  259.     GetClassName := AppName;
  260. end;
  261.  
  262. function TMDITool.InitChild : PWindowsObject;
  263. begin
  264.     InitChild := New(PMDIChild, Init(@Self, 'MDI Child Window'));
  265. end;
  266.  
  267. procedure TMDITool.GetWindowClass (var AWndClass: TWndClass);
  268. begin
  269.     TMDIWindow.GetWindowClass(AWndClass);
  270.     {***
  271.  
  272.         Sets the MDI Window background to the same color as the client area so
  273.         that when the toolbar moves you don't see a different background color flash.
  274.  
  275.     ***}
  276.     AWndClass.HBrBackground := BkBrush;
  277.     AWndClass.HIcon := LoadIcon(HInstance, 'MDIIcon');
  278. end;
  279.  
  280. procedure TMDITool.SetUpWindow;
  281. begin
  282.     TMDIWindow.SetUpWindow;
  283.     CreateChild;
  284.     {*** Check the top menu item ***}
  285.     CheckMenuItem(Attr.Menu, idm_TopToolbar, mf_ByCommand or mf_Checked);
  286. end;
  287.  
  288. procedure TMDITool.InitClientWindow;
  289. begin
  290.     TMDIWindow.InitClientWindow;
  291.     with ClientWnd^.Attr do
  292.         Style := Style or ws_VScroll or ws_HScroll;
  293. end;
  294.  
  295. procedure TMDITool.WMCtlColor(var Msg: TMessage);
  296. begin
  297.     {***
  298.  
  299.         TMWCCStatic paints the border around the static. To save on painting it doesn't fill
  300.         the centre. The CtlColor(Msg) does that. This means there is no repainting problems
  301.         when a covered static is uncovered etc etc.
  302.  
  303.     ***}
  304.     case Msg.LParamHi of
  305.         CtlColor_Static:
  306.         begin
  307.             SetBkMode(Msg.WParam, Transparent);
  308.             Msg.Result := GetStockObject(LtGray_Brush);
  309.         end;
  310.     else
  311.         TMDIWindow.DefWndProc(Msg);
  312.     end;
  313. end;
  314.  
  315. procedure TMDITool.WMDrawItem (var Msg:tMessage);
  316. {***
  317.  
  318.     Draws the ownerdraw buttons.
  319.  
  320. ***}
  321. begin
  322.     with PDrawItemStruct(Msg.lParam)^ do
  323.     case CtlType of
  324.             odt_Button:
  325.                 case CtlID of
  326.                     idw_But1 : But1^.DrawItem(Msg);
  327.                     idw_But2 : But2^.DrawItem(Msg);
  328.                     idw_But3 : But3^.DrawItem(Msg);
  329.                     idw_But4 : But4^.DrawItem(Msg);
  330.                     idw_But5 : But5^.DrawItem(Msg);
  331.                     idw_But6 : But6^.DrawItem(Msg);
  332.                 end;
  333.     end;
  334. end;
  335.  
  336. procedure TMDITool.WMSize(var Msg: TMessage);
  337. var
  338.     CRect : TRect;
  339. begin
  340.     {*** Gets the client cordinates in parent values. This is used to reposition the toolbar ***}
  341.     GetClientRect (HWindow, CRect);
  342.     with CRect do
  343.     begin
  344.         X := Left;
  345.         Y := Top;
  346.         W := Right;
  347.         H := Bottom;
  348.     end;
  349.     {*** The three positions for the Toolbar ***}
  350.     if ToolbarPos = ctl_Top then TopToolbar(Msg);
  351.     if ToolbarPos = ctl_Left then LeftToolbar(Msg);
  352.     if ToolbarPos = ctl_Right then RightToolbar(Msg);
  353.     {***
  354.  
  355.         After moving the Toolbar the static is invalidated so it displays properly.
  356.         I didn't invalidate the buttons here as they only need to be invalidated when
  357.         they move relative to the client area. A call to DefWndProc at the button level
  358.         accomplishes this later.
  359.  
  360.     ***}
  361.     InValidateRect(Stat1^.HWindow, nil, True);
  362. end;
  363.  
  364. procedure TMDITool.TopToolbar (var Msg: TMessage);
  365. {***
  366.  
  367.     TopToolbar places the toolbar along the top and readjusts the client area accordingly;
  368.     The  -1 value makes sure you don't see a double black border around the buttons etc.
  369.  
  370. ***}
  371. begin
  372.     if not IsIconic(HWindow) then
  373.     begin
  374.         MoveWindow(But1^.HWindow, -1, -1, 74, 54, False);
  375.         MoveWindow(But2^.HWindow, 72, -1, 74, 54, False);
  376.         MoveWindow(But3^.HWindow, 145, -1, 74, 54, False);
  377.         MoveWindow(But4^.HWindow, 218, -1, 74, 54, False);
  378.         MoveWindow(But5^.HWindow, 291, -1, 74, 54, False);
  379.         MoveWindow(But6^.HWindow, 364, -1, 74, 54, False);
  380.     end;
  381.     MoveWindow(Stat1^.HWindow, 437, -1, W-436, 54, False);
  382.     if (ClientWnd <> nil) and (ClientWnd^.HWindow <> 0) then
  383.         MoveWindow(ClientWnd^.HWindow, X, 53, W, H-53, True);
  384. end;
  385.  
  386. procedure TMDITool.LeftToolbar (var Msg: TMessage);
  387. {***
  388.  
  389.     LeftToolbar moves the toolbar to the left side and readjusts the client area accordingly;
  390.  
  391. ***}
  392. begin
  393.     if not IsIconic(HWindow) then
  394.     begin
  395.         MoveWindow(But1^.HWindow, -1, -1, 74, 54, False);
  396.         MoveWindow(But2^.HWindow, -1, 52, 74, 54, False);
  397.         MoveWindow(But3^.HWindow, -1, 105, 74, 54, False);
  398.         MoveWindow(But4^.HWindow, -1, 158, 74, 54, False);
  399.         MoveWindow(But5^.HWindow, -1, 211, 74, 54, False);
  400.         MoveWindow(But6^.HWindow, -1, 264, 74, 54, False);
  401.     end;
  402.     MoveWindow(Stat1^.HWindow, -1, 317, 74, H-316, False);
  403.     if (ClientWnd <> nil) and (ClientWnd^.HWindow <> 0) then
  404.         MoveWindow(ClientWnd^.HWindow, X+73, Y, W-73, H, True);
  405. end;
  406.  
  407. procedure TMDITool.RightToolbar (var Msg: TMessage);
  408. {***
  409.  
  410.     RightToolbar moves the toolbar to the right side and readjusts the client area accordingly;
  411.  
  412. ***}
  413. begin
  414.     if not IsIconic(HWindow) then
  415.     begin
  416.         MoveWindow(But1^.HWindow, W-73, -1, 74, 54, False);
  417.         MoveWindow(But2^.HWindow, W-73, 52, 74, 54, False);
  418.         MoveWindow(But3^.HWindow, W-73, 105, 74, 54, False);
  419.         MoveWindow(But4^.HWindow, W-73, 158, 74, 54, False);
  420.         MoveWindow(But5^.HWindow, W-73, 211, 74, 54, False);
  421.         MoveWindow(But6^.HWindow, W-73, 264, 74, 54, False);
  422.     end;
  423.     MoveWindow(Stat1^.HWindow, W-73, 317, 74, H-316, False);
  424.     if (ClientWnd <> nil) and (ClientWnd^.HWindow <> 0) then
  425.         MoveWindow(ClientWnd^.HWindow, X, Y, W-73, H, True);
  426. end;
  427.  
  428. procedure TMDITool.IDMTopToolbar (var Msg: TMessage);
  429. begin
  430.     {***
  431.  
  432.         The main window needs to be invalidated when the toolbar changes positon
  433.         to ensure the controls move smoothly to the their position.
  434.  
  435.     ***}
  436.     InValidateRect(HWindow, nil, True);
  437.     {*** Resets the Toolbar constant ***}
  438.     ToolbarPos := ctl_Top;
  439.     WMSize(Msg);
  440.     {*** Checks the appropriate menu item ***}
  441.     CheckMenuItem(Attr.Menu, idm_TopToolbar, mf_ByCommand or mf_Checked);
  442.     CheckMenuItem(Attr.Menu, idm_LeftToolbar, mf_ByCommand or mf_UnChecked);
  443.     CheckMenuItem(Attr.Menu, idm_RightToolbar, mf_ByCommand or mf_UnChecked);
  444. end;
  445.  
  446. procedure TMDITool.IDMLeftToolbar (var Msg: TMessage);
  447. begin
  448.     InValidateRect(HWindow, nil, True);
  449.     ToolbarPos := ctl_Left;
  450.     WMSize(Msg);
  451.     CheckMenuItem(Attr.Menu, idm_TopToolbar, mf_ByCommand or mf_UnChecked);
  452.     CheckMenuItem(Attr.Menu, idm_LeftToolbar, mf_ByCommand or mf_Checked);
  453.     CheckMenuItem(Attr.Menu, idm_RightToolbar, mf_ByCommand or mf_UnChecked);
  454. end;
  455.  
  456. procedure TMDITool.IDMRightToolbar (var Msg: TMessage);
  457. begin
  458.     InValidateRect(HWindow, nil, True);
  459.     ToolbarPos := ctl_Right;
  460.     WMSize(Msg);
  461.     CheckMenuItem(Attr.Menu, idm_TopToolbar, mf_ByCommand or mf_UnChecked);
  462.     CheckMenuItem(Attr.Menu, idm_LeftToolbar, mf_ByCommand or mf_UnChecked);
  463.     CheckMenuItem(Attr.Menu, idm_RightToolbar, mf_ByCommand or mf_Checked);
  464. end;
  465.  
  466. procedure TMDITool.IDMAbout (var Msg: TMessage);
  467. begin
  468.     Application^.ExecDialog(New(PAboutDialog, Init(@Self, 'AboutDialog', 'MWCC')));
  469. end;
  470.  
  471. procedure TMDITool.IDWBut1 (var Msg:tMessage);
  472. {*** An example of an open file dialog box ***}
  473. var
  474.     Dir, Name, Ext: array[0..fsPathName] of Char;
  475.     ADlg : PSFXFileDlg;
  476. begin
  477.     ADlg := (New(PSFXFileDlg, Init(@Self, 'SFXFileDlg', True)));
  478.     if ADlg <> nil then
  479.     begin
  480.         if ADlg^.Execute = idOk then
  481.         with ADlg^, OpenFileName do
  482.         begin
  483.             FileSplit(FilePath, Dir, Name, Ext);
  484.             Winexec(FilePath, sw_Normal);
  485.         end;
  486.         ADlg^.free
  487.     end;
  488. end;
  489.  
  490. procedure TMDITool.IDWBut2 (var Msg:tMessage);
  491. {***
  492.  
  493.     An example of a save file as dialog box. Here nil sets the dialog box to light gray
  494.     instead of a bitmap pattern. False means its a save as file dialog box. True means open.
  495.  
  496. ***}
  497. var
  498.     Dir, Name, Ext: array[0..fsPathName] of Char;
  499.     ADlg : PMWCCFileDlg;
  500. begin
  501.     ADlg := (New(PMWCCFileDlg, Init(@Self, 'MWCCFileDlg', nil, False)));
  502.     if ADlg <> nil then
  503.     begin                                             
  504.         if ADlg^.Execute = idOk then
  505.         with ADlg^, OpenFileName do
  506.         begin
  507.             FileSplit(FilePath, Dir, Name, Ext);
  508.             MWCCMsgBox(HWindow, 'There is nothing to save but while your here ' +
  509.                               'do you like this message box?.',
  510.                               'Information', mb_YesNo or mb_IconQuestion, nil);
  511.         end;
  512.         ADlg^.free
  513.     end;
  514. end;
  515.  
  516. procedure TMDITool.IDWBut3 (var Msg:tMessage);
  517. {***
  518.  
  519.     Minimum required to use TMWCCFontDlg. The font information from the font selected
  520.     in the dialog box is automatically transfered to the TLogFont structure. Using FontText
  521.     and lCustData you can customize the sample text displayed in the font dialog box. If
  522.     lCustData := 0 the default text will be used.
  523.  
  524.     There are two resource templates, one for TMWCCFontDlg and one for TSFXFontDlg. As the file
  525.     MCommDlg.res contains all the dialog templates no unit actually calls this file. You will
  526.     have to add the appropriate template to you resource file. If you move the static control
  527.     number 1093 outside groupbox number 1073 or if cf_Both or cf_printerfonts is not specified
  528.     the Sample Text will re-centres itself inside the groupbox.
  529.  
  530.     Customization. The only customizing you would want to do is to change the sample text. This
  531.     can be done as below so there is no need to dervie your own dialog objwect unless you want to
  532.     add something. You might want to center the dialog over the window or screen using the
  533.     CenterOverWindow or CentreOverScreen functions.
  534.  
  535.     If you don't specify cf_Both or cf_Printerfonts then the dialog wont use static control
  536.     number 1093. I suggest you move this control outside the dialog along side the other unused
  537.     controls (don't delete it) and resize the Sample group box so it's narrower and longer. It
  538.     will then match the total lengths of the Combo boxes above and look better.
  539.  
  540. ***}
  541. var
  542.     FontRec  : TChooseFont;
  543.     Style    : array [0..100] of Char;
  544.     FontDlg  : PMWCCFontDlg;
  545.     FontText : PChar;
  546.     ChildWnd : HWnd;
  547. begin
  548.     FillChar(FontRec, SizeOf(FontRec), #0);
  549.     FontText := 'Sample';
  550.     with FontRec do
  551.     begin
  552.         lStructSize:= SizeOf(TChooseFont);
  553.         lpLogFont  := @LogFont;
  554.         Flags      := cf_Both or cf_Effects or cf_InitToLogFontStruct;
  555.         lCustData  := LongInt(FontText);
  556.         rgbColors  := ColorRef;
  557.         lpszStyle  := Style;
  558.     end;
  559.     FontDlg := New(PMWCCFontDlg, Init(@Self, 'MWCCFontdlg', @FontRec, 'BWCC'));
  560.     if (FontDlg = nil) or (FontDlg^.Execute <> id_Ok) then Exit;
  561.     ColorRef:= FontRec.rgbColors;
  562.     {*** Add/replace your code here ***}
  563.     ChildWnd := SendMessage(ClientWnd^.HWindow, wm_MDIGetActive, 0, 0);
  564.     SendMessage(ChildWnd, wm_Paint, 0, 0);
  565. end;
  566.  
  567. procedure TMDITool.IDWBut4 (var Msg:tMessage);
  568. {***
  569.  
  570.     The MWCCMsgBox and SFXMsgBox functions exactly mirror the Windows API Messagebox function.
  571.     They now take a window handle instead of a PWindowsObject pointer and can be used as a
  572.     stand alone message boxes or from within constructors by setting the Window hanlde to zero.
  573.  
  574. ***}
  575. begin
  576.     MWCCMsgBox(HWindow, 'This is an MWCC message box. It can be created using the ' +
  577.                                             'MWCCMsgBox function. MWCC message boxes can display one of ' +
  578.                                             'three custom backgrounds. This is the BWCC Background',
  579.                                             'MWCC Message Box', mb_YesNoCancel or mb_DefButton2 or
  580.                                              mb_IconInformation, 'BWCC');
  581. end;
  582.  
  583. procedure TMDITool.IDWBut5 (var Msg:tMessage);
  584. begin
  585.     MWCCMsgBox(HWindow, 'This is an MWCC message box. It can be created using the ' +
  586.                                             'MWCCMsgBox function. MWCC message boxes can display one of ' +
  587.                                             'three custom backgrounds. This is the MWCC Background',
  588.                                             'MWCC Message Box', mb_OkCancel or mb_IconStop, 'MWCC');
  589. end;
  590.  
  591. procedure TMDITool.IDWBut6 (var Msg:tMessage);
  592. begin
  593.     SFXMsgBox(HWindow, 'This is an SFX message box. It can be created using the SFXMsgBox ' +
  594.                                          'function.', 'SpecialFX Message Box', mb_AbortRetryIgnore or
  595.                                             mb_IconExclamation or mb_DefButton3);
  596. end;
  597.  
  598. {********** TMDIChild **********}
  599.  
  600. constructor TMDIChild.Init (AParent: PWindowsObject; AName: PChar);
  601. begin
  602.     TWindow.Init(AParent, AName);
  603.     with LogFont do
  604.     begin
  605.         lfHeight         := -35;
  606.         lfWidth          := 0;
  607.         lfEscapement     := 0;
  608.         lfOrientation    := 0;
  609.         lfWeight         := 700;
  610.         lfItalic         := 1;
  611.         lfUnderLine      := 1;
  612.         lfStrikeout      := 0;
  613.         lfCharSet        := 0;
  614.         lfOutPrecision   := Out_Stroke_Precis;
  615.         lfClipPrecision  := Clip_Stroke_Precis;
  616.         lfQuality        := Default_Quality;
  617.         lfPitchAndFamily := Variable_Pitch;
  618.         StrCopy(lfFaceName, 'Times New Roman');
  619.     end;
  620.     ColorRef  := RGB(255, 0, 0);
  621. end;
  622.  
  623. procedure TMDIChild.GetWindowClass (var AWndClass: TWndClass);
  624. begin
  625.     TWindow.GetWindowClass(AWndClass);
  626.     AWndClass.HBrBackground := GetStockObject(Black_Brush);
  627. end;
  628.  
  629. procedure TMDIChild.WMPaint (var Msg: TMessage);
  630. var
  631.     PS : TPaintStruct;
  632.     CRect : TRect;
  633.     PaintDC : HDC;
  634.     OldObject : THandle;
  635. begin
  636.     TWindow.WMPaint(Msg);
  637.     BeginPaint(HWindow, PS);
  638.     PaintDC := GetDC(HWindow);
  639.     SetTextColor(PaintDC, ColorRef);
  640.     SetBkMode(PaintDC, Transparent);
  641.     GetClientRect(HWindow, CRect);
  642.     FillRect(PaintDC, CRect, GetStockObject(Black_Brush));
  643.     TheFont := CreateFontIndirect(LogFont);
  644.     OldObject := SelectObject(PaintDC, TheFont);
  645.     DrawText(PaintDC, 'Borland Pascal 7.0', -1, CRect, dt_Center or dt_vCenter or dt_Singleline);
  646.     SelectObject(PaintDC, OldObject);
  647.     DeleteObject(TheFont);
  648.     ReleaseDC(HWindow, PaintDC);
  649.     EndPaint(HWindow, PS);
  650. end;
  651.  
  652. {********** TMDIButton **********}
  653.  
  654. constructor TMDIButton.Init(AParent: PWindowsObject; AnID, X, Y: Integer;
  655.                                                          IsDefault: Boolean; iBmp: Integer; AStyle: Word);
  656. begin
  657.     TMWCCBmpButton.Init(Aparent, AnId, X, Y, IsDefault, iBmp, AStyle);
  658.     {***
  659.  
  660.         These two line are important.  They set the button objects to non MDI. Without these
  661.         lines you would see MDI child windows instead of buttons.
  662.  
  663.     ***}
  664.     SetFlags(wb_MDIChild, False);
  665.     DefaultProc := @DefWindowProc;
  666. end;
  667.  
  668. procedure TMDIButton.DefWndProc(Var Msg : TMessage);
  669. begin
  670.     with Msg do
  671.         if Message = wm_Move then
  672.         begin
  673.          InvalidateRect(HWindow, nil, True);
  674.         end
  675.     else
  676.         TMWCCBmpButton.DefWndProc(Msg);
  677. end;
  678.  
  679. {********** TMDIStatic **********}
  680.  
  681. constructor TMDIStatic.Init (AParent: PWindowsObject; AnId: Integer; ATitle: PChar;
  682.                                             X, Y, W, H: Integer; ATextLen, AShade: Word; IsBold: Boolean);
  683. begin
  684.     TMWCCStatic.Init(Aparent, AnId, ATitle, X, Y, W, H, ATextLen, AShade, IsBold);
  685.     {***
  686.  
  687.         These two line are important.  They set the static object to non MDI. Without these
  688.         lines you would see a MDI child window instead of a raised static.
  689.  
  690.     ***}
  691.     SetFlags(wb_MDIChild, False);
  692.     DefaultProc := @DefWindowProc;
  693. end;
  694.  
  695. {********** TAboutDialog **********}
  696.  
  697. constructor TAboutDialog.Init(AParent: PWindowsObject; AName, ABmp: PChar);
  698. {***
  699.  
  700.     This initializes a recessed TMWCCStatic object and the BWCC style
  701.     Ok Button' (id 1) in MWCC.dll.
  702.  
  703. ***}
  704. begin
  705.     TMWCCDialog.Init(AParent, AName, ABmp);
  706.     Stat1 := New(PMWCCStatic, InitResource(@Self, idd_Stat1, 0, ctl_Recessed));
  707.     Stat2 := New(PMWCCStatic, InitResource(@Self, idd_Stat2, 0, ctl_Recessed));
  708.     if GetSystemMetrics(sm_CYSize) = 26 then
  709.         OkBut := New(PMWCCBmpButton, Init(@Self, id_Ok, 158, 216, False, 1, ctl_Flush))
  710.     else
  711.         OkBut := New(PMWCCBmpButton, Init(@Self, id_Ok, 116, 169, False, 1, ctl_Flush));
  712. end;
  713.  
  714. procedure TAboutDialog.SetUpWindow;
  715. begin
  716.     TMWCCDialog.SetUpWindow;
  717.     {*** Centres the About dialog over the MDITool client area ***}
  718.     CenterOverClient(Parent^.HWindow, HWindow);
  719. end;
  720.  
  721. procedure TAboutDialog.WMDrawItem(var Msg:tMessage);
  722. {*** Draws the Ok Button ***}
  723. begin
  724.     with PDrawItemStruct(Msg.lParam)^ do
  725.     case CtlType of
  726.       odt_Button:
  727.         case CtlID of
  728.                     id_Ok : OkBut^.DrawItem(Msg);
  729.                 end;
  730.     end;
  731. end;
  732.  
  733. {********** Main Program **********}
  734.  
  735. var
  736.     App: TMDIToolApplication;
  737. begin
  738.     App.Init(AppName);
  739.     App.Run;
  740.     App.Done;
  741. end.
  742.